{-# LANGUAGE ImpredicativeTypes #-}
module Magicloud.Jobs where

import Control.Concurrent
import Control.Exception
import qualified Data.Map as M
import qualified Magicloud.Map as Map
import qualified Control.Concurrent.MVar.ReadOnly as ROMVar

data JobInfo a e = JobInfo { jobId :: ThreadId
                           , status :: ROMVar.ReadOnlyMVar (Either e a) }

type Jobs k e a = M.Map k (JobInfo a e)

type JobArgs k a = M.Map k a

type JobResults k e a = M.Map k (Either e a)

start :: (Ord k, Exception e) => JobArgs k a -> (a -> IO b) -> IO (Jobs k e b)
start args worker = mask_ $ do
  arg <- newEmptyMVar
  Map.mapM (\a -> do
             putMVar arg a
             res <- newEmptyMVar
             tId <- forkIOWithUnmask $ \unmask -> do
               arg_ <- takeMVar arg
               res_ <- try $ unmask $ worker arg_
               putMVar res res_
             return $ JobInfo tId $ ROMVar.toReadOnlyMVar res
           ) args

wait :: (Ord k, Exception e) => Jobs k e a -> IO (JobResults k e a)
wait = Map.mapM (ROMVar.takeMVar . status)

kill :: (Ord k, Exception e) => Jobs k e a -> IO (JobResults k e a)
kill = Map.mapM (\job -> do
                  killThread $ jobId job
                  ROMVar.takeMVar $ status job
                )
